BBS in a Box 3/BBS in a box - Trilogy III.iso/Files/Prog/S/Scientist's Spreadsheet/Procedures/Useful Procedures

Text File | 1987-02-26 | 16.4 KB | 767 lines | [TEXT/EDIT]

'' 'useful Scientists Spreadsheet V2.17 procedures, by William Menke'
'' 'Caveat Emptor'


label arrow
'' 'draws an arrow on the graph where the user clicks'
'' 'argument 1 is the arrow line type (solid, bold, dotted, dashed)'
setvar xminsave @xmin
setvar xmaxsave @xmax
setvar yminsave @ymin
setvar ymaxsave @ymax
yaxis 0 0.6
xaxis 0 1
cursor 'pick head of arrow'
setvar x @xpos
setvar y @ypos
cursor 'pick tail of arrow'
vector @x @y @xpos @ypos @arg1
vm @x - @xpos = dx
vm @y - @ypos = dy
vm @dy / @dx = theta
vf atan @theta theta
if @dx > 0
        vm 3.14159 + @theta = theta
vm @theta - 0.3 = theta
vf sin @theta st
vf cos @theta ct
vm @ct * 0.04 = dx
vm @st * 0.04 = dy
vm @dx + @x = xpos
vm @dy + @y = ypos
vector @x @y @xpos @ypos @arg1
vm @theta + 0.6 = theta
vf sin @theta st
vf cos @theta ct
vm @ct * 0.04 = dx
vm @st * 0.04 = dy
vm @dx + @x = xpos
vm @dy + @y = ypos
vector @x @y @xpos @ypos @arg1
xaxis @xminsave @xmaxsave
yaxis @yminsave @ymaxsave
delete variable xminsave
delete variable xmaxsave
delete variable yminsave
delete variable ymaxsave
delete variable x
delete variable y
delete variable st
delete variable ct
delete variable dx
delete variable dy
delete variable theta
return


label autocorrelation
'' 'autocorrelation of time series in column 2'
'' 'columns 3 and 4 are used, autocorrelation returned in 2'
'' 'the number of rows in the table is doubled, so'
'' 'the table allocation must be sufficiently large'
'' 'the table must be interpolated.  col 1 is reset to lag'
refresh false
cols 4
copy col 2 3
reverse 3 3
setvar length @rows
vm @rows + 1 = a
vm @rows * 2 = b
rows @b
constant 0 2 @a @b
constant 0 3 @a @b
conv 2 3 @length 4
vm -1.0 * @length = a
vm @samp * @a = a
vm @a + @samp = a
start @a
copy col 4 2
cols 2
delete variable a
delete variable b
delete variable length
return


label clip
'' 'clips values in a column'
'' 'argument 1: minimum value'
'' 'argument 2: maximum value
'' 'argument 3: input col'
'' 'argument 4: output col'
refresh false
copy col @arg3 @arg4
for i 1 @rows
    set x table @i @arg4
    if @x < @arg1
        table @i @arg4 @arg1
    if @x > @arg2
        table @i @arg4 @arg2
    next i
delete variable x
return


label crosscorrelation
'' 'autocorrelation of time series in columns 2 and 3'
'' 'column 4 is used, crosscorrelation returned in 3'
'' 'the number of rows in the table is doubled, so'
'' 'the table allocation must be sufficiently large'
'' 'the table must be interpolated.  col 1 is reset to lag'
refresh false
cols 4
reverse 3 3
setvar length @rows
vm @rows + 1 = a
vm @rows * 2 = b
rows @b
constant 0 2 @a @b
constant 0 3 @a @b
conv 2 3 @length 4
vm -1.0 * @length = a
vm @samp * @a = a
vm @a + @samp = a
start @a
copy col 4 2
cols 2
delete variable a
delete variable b
delete variable length
return


label drawcurve
'' 'draw a curve by clicking the mouse on the graphics screen'
'' 'prompts for input'
refresh false
input arg1 'enter abcissa column'
input arg2 'enter ordinate column'
input xmin 'enter the minimum absicca value'
input xmax 'enter the maximum abcissa value'
xaxis @xmin @xmax
input ymin 'enter the minimum ordinate value'
input ymax 'enter the maximum ordinate value'
yaxis @ymin @ymax
clear
axes
setvar x 0
setvar y 0
for i 1 @rows
    cursor 'pick a point'
    table @i @arg1 @xpos
    table @i @arg2 @ypos
    if @i <> 1
        vector @x @y @xpos @ypos
        setvar x @xpos
    setvar y @ypos
    next i
delete variable x
delete variable y
return


label drawhist
'' 'draws a histogram'
'' 'argument 1 is the column containing the data'
'' 'assumes the table is set up as it would be after a histogram command'
'' 'interpolated table only'
refresh false
scale 1 @arg1
clear
axes
cm @arg1 /# 2.0 = @arg1
vbars 1 @arg1 @arg1
cm @arg1 *# 2.0 = @arg1
return


label letter
'' 'puts character string in graphics window at mouse click'
'' 'argument 1:  the string'
cursor 'click where you want the string'
anotate @xpos @ypos @arg1
return


label logplot
'' 'log-log plot'
'' 'prompts for input'
input xcol 'abcissa col? '
input left 'left power of ten'
input width 'number of decades? '
vm @left + @width = right
yaxis @left @right
input ycol 'ordinate col? '
input top 'top power of ten? '
input height 'number of decades'
vm @top - @height = bottom
input symbol 'plotting symbol? '
input axes 'plot axes? y or n'
xaxis @left @right
yaxis @bottom @top
if @axes s= y 28
clear
vector @left @bottom @left @top
vector @left @bottom @right @bottom
vm @ymax - @ymin = y1
vm @y1 / 30 = y1
vm @y1 * 3 = y2
vm @ymin + @y1 = y1
vm @ymin - @y2 = y2
for i @left @right
    vector @i @ymin @i @y1
    vm @i * 2.302585 = t
    vf exp @t t
    anotate @i @y2 @t
    next i
vm @xmax - @xmin = y1
vm @y1 / 30 = y1
vm @y1 * 5.0 = y2
vm @xmin + @y1 = y1
vm @xmin - @y2 = y2
for i @bottom @top
    vector @xmin @i @y1 @i
    vm @i * 2.302585 = t
    vf exp @t t
    anotate @y2 @i @t
    next i
delete variable t
delete variable y1
delete variable y2
setvar oldinterp @interpolated
if @xcol = 1
    interpolated false
if @ycol = 1
    interpolated false
cf ln @xcol @xcol
cm @xcol /# 2.302585 = @xcol
cf ln @ycol @ycol
cm @ycol /# 2.3026 = @ycol
plot @xcol @ycol @symbol
cm @xcol *# 2.302585 = @xcol
cf exp @xcol @xcol
cm @ycol *# 2.302585 = @ycol
cf exp @ycol @ycol
if @xcol = 1
    interpolated @oldinterp
if @ycol = 1
    interpolated @oldinterp
delete variable oldinterp
delete variable left
delete variable right
delete variable top
delete variable bottom
delete variable height
delete variable width
delete variable symbol
delete variable xcol
delete variable ycol
return


label movingaverage
'' 'moving average with centered triangualar averaging operator'
'' 'points off end of signal assumed to be zero'
'' 'prompts for input'
refresh false
if @interpolated s<> true 3
    prompt 'Error: table must be interpolated'
    beep
    return
input half-width 'half width of triangle in units of col 1?'
vmath @half-width / @samp = half-width
vfunction int @half-width @half-width
prompt 'half width = ' @half-width ' samples'
vmath @half-width * @samp = height
vmath 1 / @height = height
input input-col 'input column?'
input output-col 'output column?'
input temp-col 'temporary result column?'
copy col @input-col @output-col
constant @height @temp-col 1 @half-width
convolve @output-col @temp-col @half-width @output-col
reverse @output-col @output-col
convolve @output-col @temp-col @half-width @output-col
reverse @output-col @output-col
delete variable half-width
delete variable  input-col
delete variable output-col
delete variable temp-col
delete variable height
return


label naner
'' 'you click on the graphics screen'
'' 'to change the value of a table entry to NaN'
'' 'argument 1 is the ordinate column'
'' 'interpolated tables only'
'' 'procedure must be aborted from the menu'
refresh false
scale 1 2
label naner-loop
clear
plot 1 @arg1
cursor 'pick a point'
vf row @xpos xpos
table @xpos @arg1 NaN
goto naner-loop
return


label numberplot
'' 'plots data and anotates the row number to the right of'
'' 'each point'
'' 'argument 1 is the abcissa column'
'' 'argument 2 is the ordinate column'
'' 'argument 3 is the plotting symbol (defaults to x)'
if @arg3 s= ''
    setvar arg3 x
plot @arg1 @arg2 @arg3
for i 1 @rows
    set x table @i @arg1
    set y table @i @arg2
    anotate @x @y @i
    next i
delete variable x
delete variable y
return



label plot1
'' 'plot all columns against column 1'
'' 'argument 1: plotting symbol'
'' 'argument 2: optional second plotting symbol'
'' 'example:  x   plot1  solid  circles'
'' 'plots each column with solid line and circles'
for column 2 @cols
    prompt 'column ' @column ' against column 1'
    clear
    scale 1 @column
    axes
    plot 1 @column @arg1
    if @arg2 s<> ''
        plot 1 @column @arg2
    input question 'plot next column? y or n'
    if @question s= n
        return
    next column
return



label plotall
'' 'plot all columns againsteach other'
'' 'argument 1: plotting symbol'
'' 'argument 2: optional second plotting symbol'
'' 'example:  x   plotall  solid  circles'
'' 'plots each column with solid line and circles'
vmath @cols - 1 = end
for xcolumn 1 @end
vmath @xcolumn + 1 = begin
for ycolumn  @begin @cols
    prompt 'column ' @ycolumn ' against ' @xcolumn
    clear
    scale  @xcolumn @ycolumn
    axes
    plot @xcolumn @ycolumn @arg1
    if @arg2 s<> ''
        plot @xcolumn @ycolumn @arg2
    input question 'next plot? y or n'
    if @question s= n 3
        delete variable begin
        delete variable end
        return
    next ycolumn
    next xcolumn
delete variable begin
delete variable end
return


label pointer
'' 'draws a labeled arrow on the graph where the user clicks'
'' 'argument 1 is the character string'
'' 'argument 2 is the arrow line type (solid, bold, dotted, dashed)'
refresh false
setvar xminsave @xmin
setvar xmaxsave @xmax
setvar yminsave @ymin
setvar ymaxsave @ymax
yaxis 0 0.6
xaxis 0 1
cursor 'pick head of arrow'
setvar x @xpos
setvar y @ypos
cursor 'pick tail of arrow'
vector @x @y @xpos @ypos @arg2
concat arg1 ' ' @arg1
anotate @xpos @ypos @arg1
vm @x - @xpos = dx
vm @y - @ypos = dy
vm @dy / @dx = theta
vf atan @theta theta
if @dx > 0
        vm 3.14159 + @theta = theta
vm @theta - 0.3 = theta
vf sin @theta st
vf cos @theta ct
vm @ct * 0.04 = dx
vm @st * 0.04 = dy
vm @dx + @x = xpos
vm @dy + @y = ypos
vector @x @y @xpos @ypos @arg2
vm @theta + 0.6 = theta
vf sin @theta st
vf cos @theta ct
vm @ct * 0.04 = dx
vm @st * 0.04 = dy
vm @dx + @x = xpos
vm @dy + @y = ypos
vector @x @y @xpos @ypos @arg2
xaxis @xminsave @xmaxsave
yaxis @yminsave @ymaxsave
delete variable xminsave
delete variable xmaxsave
delete variable yminsave
delete variable ymaxsave
delete variable x
delete variable y
delete variable st
delete variable ct
delete variable dx
delete variable dy
delete variable theta
return


label pt
'' 'does a clear, scale, axes, and plot'
'' 'same arguments as the plot command'
'' 'argument 1: abcissa_col'
'' 'argument 2: ordinate col'
clear
scale @arg1 @arg2
axes
plot @arg1 @arg2 @arg3
return


label rf
label rfunction
'' 'row functions, like cfunction command'
'' 'argument 1, function name'
'' 'argument 2, input row'
'' 'argument 3, output row'
refresh false
for i 1 @cols
    set x table @arg2 @i
    vf @arg1 @x x
    table  @arg3 @i @x
    next i
delete variable x
return


label rm
label rmath
'' 'row arithmetic, like cmath command, except omit = sign'
'' 'argument 1, first input row or constant'
'' 'argument 2, operator'
'' 'argument 3, second input row'
'' 'argument 4, output row'
refresh false
if @arg2 s= + 7
    for i 1 @cols
        set x table @arg1 @i
        set y table @arg3 @i
        vm @x + @y = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= - 7
    for i 1 @cols
        set x table @arg1 @i
        set y table @arg3 @i
        vm @x - @y = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= * 7
    for i 1 @cols
        set x table @arg1 @i
        set y table @arg3 @i
        vm @x * @y = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= / 7
    for i 1 @cols
        set x table @arg1 @i
        set y table @arg3 @i
        vm @x + @y = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= +# 6
    for i 1 @cols
        set x table @arg1 @i
        vm @x + @arg3 = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= -# 6
    for i 1 @cols
        set x table @arg1 @i
        vm @x - @arg3 = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= *# 6
    for i 1 @cols
        set x table @arg1 @i
        vm @x * @arg3 = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= /# 6
    for i 1 @cols
        set x table @arg1 @i
        vm @x / @arg3 = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= #+ 6
    for i 1 @cols
        set x table @arg3 @i
        vm @arg1 / @x = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= #- 6
    for i 1 @cols
        set x table @arg3 @i
        vm @arg1 - @x = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= #* 6
    for i 1 @cols
        set x table @arg3 @i
        vm @arg1 * @x = x
        table @arg4 @i @x
        next i
    goto rm-finish
if @arg2 s= #/ 6
    for i 1 @cols
        set x table @arg3 @i
        vm @arg1 / @x = x
        table @arg4 @i @x
        next i
    goto rm-finish
p 'no such operator'
label rm-finish
delete variable x
return


label scroller
'' 'scrolls through a long plot'
'' 'you click the mouse to the right or left of center to scroll'
'' 'argument 1 is the ordinate column'
'' 'argument 2 is the screen width'
'' 'interpolated tables only'
'' 'this procedure must be aborted from the menu'
refresh false
scale 1 @arg1
vm @arg2 + @xmin = xmax
xaxis @xmin @xmax
vm @arg2 * 0.75 = arg2
vm @xmax + @xmin = middle
vm @middle / 2 = middle
label scroller-loop
    clear
    axes
    plot 1 @arg1
    cursor 'pick scroll direction'
      if @xpos < @middle 2
        vm @xmin - @arg2 = xmin
        vm @xmax - @arg2 = xmax
   if @xpos > @middle 2
        vm @xmin + @arg2 = xmin
        vm @xmax + @arg2 = xmax
    xaxis @xmin @xmax
    vm @xmax + @xmin = middle
    vm @middle / 2 = middle
    goto scroller-loop
return


label semilogplot
'' 'semi-log plot'
'' 'prompts for input'
input xcol 'abcissa col? '
input ycol 'ordinate col? '
input top 'top power of ten? '
input height 'number of decades'
scale @xcol @ycol
vm @top - @height = bottom
yaxis @bottom @top
input symbol 'plotting symbol? '
input axes 'plot axes? y or n'
if @axes s= y 31
clear
vector @xmin @ymin @xmin @ymax
vector @xmin @ymin @xmax @ymin
vm @xmax - @xmin = dx
vm @dx / 5 = dx
vm @ymax - @ymin = y1
vm @y1 / 20 = y1
vm @y1 * 2 = y2
vm @ymin + @y1 = y1
vm @ymin - @y2 = y2
setvar x @xmin
for i 1 6
    vector @x @ymin @x @y1
    anotate @x @y2 @x
    vm @x + @dx = x
    next i
vm @xmax - @xmin = y1
vm @y1 / 20 = y1
vm @y1 * 3.2 = y2
vm @xmin + @y1 = y1
vm @xmin - @y2 = y2
for i @bottom @top
    vector @xmin @i @y1 @i
    vm @i * 2.302585 = t
    vf exp @t t
    anotate @y2 @i @t
    next i
delete variable y1
delete variable y2
delete variable x
delete variable dx
setvar oldinterp @interpolated
if @ycol = 1
    interpolatef false
cf ln @ycol @ycol
cm @ycol /# 2.302585 = @ycol
plot @xcol @ycol @symbol
cm @ycol *# 2.302585 = @ycol
cf exp @ycol @ycol
if @ycol = 1
    interpolated @oldinterp
delete variable axes
delete variable oldinterp
delete variable top
delete variable bottom
delete variable height
delete variable symbol
delete variable xcol
delete variable ycol
return


label separate
'' 'separates data in a column into two groups, less than and greater than'
'' 'a given test value'
'' 'argument 1: input column'
'' 'argument 2: output column of > values'
'' 'argument 3: output column of < values'
'' 'argument 4: test value'
refresh false
copy col @arg1 @arg2
copy col @arg1 @arg3
for i 1 @rows
    set t table @i @arg1
    if   @t    >     @arg4
        table    @i     @arg2     NaN
    if    @t    <=    @arg4
        table     @i      @arg3    NaN
    next i
delete variable t
return


label stickplot
'' 'plot of vertical sticks'
'' 'argument 1 is abcissa column'
'' 'argument 2 is ordinate column'
refresh false
cm @arg2 /# 2.0 = @arg2
vbars @arg1 @arg2 @arg2
cm @arg2 *# 2.0 = @arg2
vector @xmin 0 @xmax 0
return


label transpose
'' 'transposed rows and columns of a table'
refresh false
setvar oldrows @rows
setvar oldcols @cols
if @rows < @oldcols
    rows @oldcols
if @cols < @oldrows
    cols @oldrows
if @oldrows >= @oldcols 8
    for irow 1 @oldrows
    for icol 1 @irow
        set x table @irow @icol
        set y table @icol @irow
        table @irow @icol @y
        table @icol @irow @x
        next icol
        next irow
if @oldrows < @oldcols 8
    for icol 1 @oldcols
    for irow 1 @icol
        set x table @irow @icol
        set y table @icol @irow
        table @irow @icol @y
        table @icol @irow @x
        next irow
        next icol
rows @oldcols
cols @oldrows
delete variable x
delete variable y
return



label zapper
'' 'you click on the graphics screen'
'' 'to change the value of a table entry  to the cursor pos'
'' 'argument 1 is the ordinate column'
'' 'interpolated tables only'
'' 'procedure must be aborted from the menu'
refresh false
scale 1 2
label zapper-loop
clear
plot 1 @arg1
cursor 'pick a point'
vf row @xpos xpos
table @xpos @arg1 @ypos
goto zapper-loop
return

label zpb
label zerophasebandpass
'' 'like bandpass, but zero phase and rolloff twice as fast'
'' 'same arguments as bandpass command'
refresh false
bandpass @arg1 @arg2 @arg3 @arg4
reverse @arg4 @arg4
bandpass @arg1 @arg2 @arg4 @arg4
reverse @arg4 @arg4
return